Language/OS - Multiplatform Resource Library/LANGUAGE OS.iso/pcl/src-16f.lha/code/dyncount.lisp

Lisp/Scheme | 1992-05-30 | 14KB | 432 lines

;;; -*- Package: C; Log: C.Log -*-
;;;
;;; **********************************************************************
;;; This code was written as part of the CMU Common Lisp project at
;;; Carnegie Mellon University, and has been placed in the public domain.
;;; If you want to use this code or any part of CMU Common Lisp, please contact
;;; Scott Fahlman or [e-mail].
;;;
(ext:file-comment
  "$Header: dyncount.lisp,v 1.2 92/02/13 09:54:29 ram Exp $")
;;;
;;; **********************************************************************
;;;
;;; Runtime support for dynamic VOP statistics collection.
;;;
(in-package "C")

#|
Put *count-adjustments* back into VOP costs, and verify them.
Make sure multi-cycle instruction costs are plausible.
VOP classification.
  Make tables of %cost for benchmark X class.
  Could be represented as a sort of bar chart.
|#

(eval-when (compile)
  (when *collect-dynamic-statistics*
    (error "Compiling this file with dynamic stat collection turn on would ~
    be a very bad idea.")))

;;;; Hash utilities:

(defmacro do-hash ((key-var value-var table &optional result)
           &body (body decls))
  "DO-HASH (Key-Var Value-Var Table [Result]) Declaration* Form*
   Iterate over the entries in a hash-table."
  (let ((gen (gensym))
    (n-more (gensym)))
    `(with-hash-table-iterator (,gen ,table)
       (loop
     (multiple-value-bind (,n-more ,key-var ,value-var)
                  (,gen)
       ,@decls
       (unless ,n-more (return ,result))
       ,@body)))))

(defun make-hash-table-like (table)
  "Make a hash-table with the same test as table."
  (declare (type hash-table table))
  (make-hash-table :test (lisp::hash-table-kind table)))

(defun hash-difference (table1 table2)
  "Return a hash-table containing only the entries in Table1 whose key is not
   also a key in Table2." (declare (type hash-table table1 table2))
  (let ((res (make-hash-table-like table1)))
    (do-hash (k v table1)
      (unless (nth-value 1 (gethash k table2))
    (setf (gethash res k) v)))
    res))

(defun hash-list (table)
  "Return a list of the values in Table."
  (declare (type hash-table table))
  (collect ((res))
    (do-hash (k v table)
      (declare (ignore k))
      (res v))
    (res)))

;;; READ-HASH-TABLE, WRITE-HASH-TABLE  --  Public
;;;
;;;    Read (or write) a hashtable from (or to) a file.
;;;
(defun read-hash-table (file)
  (with-open-file (s file :direction :input)
    (dotimes (i 3)
      (format t "~%; ~A" (read-line s)))
    (let* ((eof '(nil))
       (test (read s))
       (reader (read s))
       (res (make-hash-table :test test)))
      (read s); Discard writer...
      (loop
    (let ((key (read s nil eof)))
      (when (eq key eof) (return))
      (setf (gethash key res)
        (funcall reader s key))))
      res)))
;;;
(defun write-hash-table (table file &key
                   (comment (format nil "Contents of ~S" table))
                   (reader 'read) (writer 'prin1) (test 'equal))
  (with-open-file (s file :direction :output :if-exists :new-version)
    (with-standard-io-syntax
      (let ((*print-readably* nil))
    (format s "~A~%Version ~A on ~A~%"
        comment (lisp-implementation-version)
        (machine-instance))
    (format-universal-time s (get-universal-time))
    (terpri s)
    (format s "~S ~S ~S~%" test reader writer)
    (do-hash (k v table)
      (prin1 k s)
      (write-char #\space s)
      (funcall writer v s)
      (terpri s)))))
  table)


;;;; Info accumulation:

;;; Used to accumulate info about the usage of a single VOP.  Cost and count
;;; are kept as double-floats, which lets us get more bits and avoid annoying
;;; overflows.
;;;
(deftype count-vector () '(simple-array double-float (2)))
;;;
(defstruct (vop-stats
        (:constructor %make-vop-stats (name))
        (:constructor make-vop-stats-key))
  (name (required-argument) :type simple-string)
  (data (make-array 2 :element-type 'double-float) :type count-vector))

(defmacro vop-stats-count (x) `(aref (vop-stats-data ,x) 0))
(defmacro vop-stats-cost (x) `(aref (vop-stats-data ,x) 1))

(defun make-vop-stats (&key name count cost)
  (let ((res (%make-vop-stats name)))
    (setf (vop-stats-count res) count)
    (setf (vop-stats-cost res) cost)
    res))

(declaim (freeze-type dyncount-info vop-stats))


;;; NOTE-DYNCOUNT-INFO  --  Internal
;;;
;;;    Add the Info into the cumulative result on the VOP name plist.  We use
;;; plists so that we will touch minimal system code outside of this file
;;; (which may be compiled with profiling on.)
;;;
(defun note-dyncount-info (info)
  (declare (type dyncount-info info) (inline get %put)
       (optimize (speed 2)))
  (let ((counts (dyncount-info-counts info))
    (vops (dyncount-info-vops info)))
    (dotimes (index (length counts))
      (declare (type index index))
      (let ((count (coerce (the (unsigned-byte 31)
                (aref counts index))
               'double-float)))
    (when (minusp count)
      (warn "Oops: overflow.")
      (return-from note-dyncount-info nil))
    (unless (zerop count)
      (let* ((vop-info (svref vops index))
         (length (length vop-info)))
        (declare (simple-vector vop-info))
        (do ((i 0 (+ i 4)))
        ((>= i length))
          (declare (type index i))
          (let* ((name (svref vop-info i))
             (entry (or (get name 'vop-stats)
                (setf (get name 'vop-stats)
                      (%make-vop-stats (symbol-name name))))))
        (incf (vop-stats-count entry)
              (* (coerce (the index (svref vop-info (1+ i)))
                 'double-float)
             count))
        (incf (vop-stats-cost entry)
              (* (coerce (the index (svref vop-info (+ i 2)))
                 'double-float)
             count))))))))))

(defun clear-dyncount-info (info)
  (declare (type dyncount-info info))
  (declare (optimize (speed 3) (safety 0)))
  (let ((counts (dyncount-info-counts info)))
    (dotimes (i (length counts))
      (setf (aref counts i) 0))))


;;; CLEAR-VOP-COUNTS  --  Public
;;;
;;;    Clear any VOP-COUNTS properties and the counts vectors for all code
;;; objects.  The latter loop must not call any random functions.
;;;
(defun clear-vop-counts (&optional (spaces '(:dynamic)))
  "Clear all dynamic VOP counts for code objects in the specified spaces."
  (do-hash (k v (backend-template-names *backend*))
    (declare (ignore v))
    (remprop k 'vop-stats))

  (locally
      (declare (optimize (speed 3) (safety 0))
           (inline vm::map-allocated-objects))
    (without-gcing
      (dolist (space spaces)
    (vm::map-allocated-objects
     #'(lambda (object type-code size)
         (declare (ignore type-code size))
         (when (dyncount-info-p object)
           (clear-dyncount-info object)))
     space)))))


;;; GET-VOP-COUNTS  --  Public
;;;
;;;    Call NOTE-DYNCOUNT-INFO on all DYNCOUNT-INFO structure allocated in the
;;; specified spaces.  Return a hashtable describing the counts.  The initial
;;; loop must avoid calling any functions outside this file to prevent adding
;;; noise to the data, since other files may be compiled with profiling.
;;;
(defun get-vop-counts (&optional (spaces '(:dynamic)) &key (clear t))
  "Return a hash-table mapping string VOP names to VOP-STATS structures
   describing the VOPs executed.  If clear is true, then reset all counts to
   zero as a side-effect."
  (locally
      (declare (optimize (speed 3) (safety 0))
           (inline vm::map-allocated-objects))
    (without-gcing
      (dolist (space spaces)
    (vm::map-allocated-objects
     #'(lambda (object type-code size)
         (declare (ignore type-code size))
         (when (dyncount-info-p object)
           (note-dyncount-info object)
           (when clear
         (clear-dyncount-info object))))
     space))))

  (let ((counts (make-hash-table :test #'equal)))
    (do-hash (k v (backend-template-names *backend*))
      (declare (ignore v))
      (let ((stats (get k 'vop-stats)))
    (when stats
      (setf (gethash k counts) stats)
      (when clear
        (remprop k 'vop-stats)))))
    counts))


;;; FIND-INFO-FOR  --  Interface
;;;
;;;    Return the DYNCOUNT-INFO for FUNCTION.
;;;
(defun find-info-for (function)
  (declare (type function function))
  (let* ((function (%primitive closure-function function))
     (component (di::function-code-header function)))
    (do ((end (get-header-data component))
     (i vm:code-constants-offset (1+ i)))
    ((= end i))
      (let ((constant (code-header-ref component i)))
    (when (dyncount-info-p constant)
      (return constant))))))


(defun vop-counts-apply (function args &key (spaces '(:dynamic)) by-space)
  "Apply Function to Args, collecting dynamic statistics on the running.
   Spaces are the spaces to scan for counts.  If By-Space is true, we return a
   list of result tables, instead of a single table.  In this case, specify
   :READ-ONLY first."
  (clear-vop-counts spaces)
  (apply function args)
  (if by-space
      (mapcar #'get-vop-counts spaces)
      (get-vop-counts spaces)))

;;;; Adjustments:

(defparameter *count-adjustments*
  '((return-multiple 152)
    (tail-call-variable 88)
    (unwind 92)
    (throw 116)
    (allocate-vector 72)
    (sxhash-simple-string 248)
    (sxhash-simple-substring 264)
    (copy-to-system-area 1200)
    (copy-from-system-area 1200)
    (system-area-copy 1204)
    (bit-bash-copy 1412)
    (vm::generic-+ 72)
    (vm::generic-- 72)
    (vm::generic-* 184)
    (vm::generic-< 68)
    (vm::generic-> 68)
    (vm::generic-eql 80)
    (vm::generic-= 80)
    (vm::generic-/= 104)
    (%make-weak-pointer 60)
    (make-value-cell 56)
    (vm::make-funcallable-instance 76)
    (make-closure 76)
    (make-complex 60)
    (make-ratio 60)
    (%allocate-bignum 72)
    (make-structure 72)
    (cons 50)))

;;; GET-VOP-COSTS  --  Public
;;;
(defun get-vop-costs ()
  "Return a hash-table mapping string VOP names to the cost recorded in the
   generator for all VOPs which are also the names of assembly routines."
  (let ((res (make-hash-table :test #'equal)))
     (do-hash (name v lisp::*assembler-routines*)
       (declare (ignore v))
       (let ((vop (gethash name (backend-template-names *backend*))))
     (when vop
       (setf (gethash (symbol-name name) res)
         (template-cost (template-or-lose name))))))
    res))

(defvar *native-costs* (get-vop-costs)
  "Costs of assember routines on this machine.")


;;;; Analysis and report generation:

;;; COST-SUMMARY  --  Internal
;;;
;;;    Sum the count and costs.
;;;
(defun cost-summary (table)
  (let ((total-count 0d0)
    (total-cost 0d0))
    (do-hash (k v table)
      (declare (ignore k))
      (incf total-count (vop-stats-count v))
      (incf total-cost (vop-stats-cost v)))
    (values total-count total-cost)))


;;; COMPENSATE-COSTS  --  Internal
;;;
;;;    Return a hashtable of DYNCOUNT-INFO structures, with cost adjustments
;;; according to the Costs table.
;;;
(defun compensate-costs (table costs)
  (let ((res (make-hash-table-like table)))
    (do-hash (key value table)
      (unless (string= key "COUNT-ME")
    (let ((cost (gethash key costs)))
      (if cost
          (let* ((count (vop-stats-count value))
             (sum (+ (* cost count)
                 (vop-stats-cost value))))
        (setf (gethash key res)
              (make-vop-stats :name key :count count :cost sum)))
          (setf (gethash key res) value)))))
    res))


;;; COMBINE-STATS  --  Internal
;;;
;;;    Take two tables of vop-stats and return a table of entries where the
;;; entries have been compared somehow.  The counts are normalized to Compared.
;;; The costs are the difference of the costs adjusted by the difference in
;;; counts: the cost for Original is modified to correspond to the count in
;;; Compared.
;;;
(defun combine-stats (original compared)
  (declare (type hash-table original compared))
  (let ((res (make-hash-table-like original)))
    (do-hash (k cv compared)
      (let ((ov (gethash k original)))
    (when ov
      (let ((norm-cnt (/ (vop-stats-count ov) (vop-stats-count cv))))
        (setf (gethash k res)
          (make-vop-stats
           :name k
           :count norm-cnt
           :cost (- (/ (vop-stats-cost ov) norm-cnt)
                (vop-stats-cost cv))))))))
    res))


;;; SORT-RESULT  --  Internal
;;;
(defun sort-result (table by)
  (sort (hash-list table) #'>
    :key #'(lambda (x)
         (abs (ecase by
            (:count (vop-stats-count x))
            (:cost (vop-stats-cost x)))))))


;;; GENERATE-REPORT  --  Public
;;;
;;; Generate a report from the specified table.
;;;
(defun generate-report (table &key (cut-off 15) (sort-by :cost)
                  (costs *native-costs*) compare)
  (let* ((compensated (if costs (compensate-costs table costs) table))
     (compared (if compare
               (combine-stats compensated compare)
               compensated))
     (*gc-verbose* nil))
    (multiple-value-bind (total-count total-cost)
             (cost-summary (or compare compensated))
      (format t "~30<Vop~>  ~13<Count~> ~6<Cost~>  ~6:@<Percent~>~%")
      (dolist (entry (sort-result compared sort-by))
    (when (and cut-off (minusp (decf cut-off)))
      (return))
    (let* ((cost (vop-stats-cost entry))
           (name (vop-stats-name entry))
           (entry-count (vop-stats-count entry))
           (comp-entry (if compare (gethash name compare) entry))
           (count (vop-stats-count comp-entry)))
      (format t "~30<~A~>: ~:[~13:D~;~13,2F~] ~6,1F  ~4,1,2F%~%"
          (vop-stats-name entry)
          compare
          (if compare entry-count (round entry-count))
          (/ cost count)
          (/ cost total-cost))))
    (format t "~%Total count ~,3E, total cost ~,3E.~%"
        total-count total-cost)))
  (values))


;;; STATS-{READER,WRITER}  --  Public
;;;
;;;    Read & write VOP stats using hash IO utility.
;;;
(defun stats-reader (stream key)
  (make-vop-stats :name key :count (read stream) :cost (read stream)))
;;;
(defun stats-writer (object stream)
  (format stream "~S ~S" (vop-stats-count object) (vop-stats-cost object)))